home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / PowerMacOberon 1.2 / Source / Tools / Xref.Mod (.txt) < prev    next >
Oberon Text  |  1995-08-22  |  8KB  |  280 lines
  1. Syntax10.Scn.Fnt
  2. FoldElems
  3. Syntax10.Scn.Fnt
  4. (*----------------------------------------------------------------
  5. Xref creates a cross reference list for Oberon-2 programs.
  6. Xref.List (^ | * | {filename} ~)
  7.     opens a viewer showing the source text of the specified file(s) with linenumbers
  8.     as well as a sorted list of names and the line numbers where they occur in the
  9.     source text.
  10. Xref.SetLineLength  number
  11.     allows the user to specify the desired line length in characters. Default is 120.
  12. Xref.SetNumberLength  number
  13.     allows the user to specify the desired number of digits per line number in order
  14.     to be able to print the line numbers in an aligned way. Default is 5.
  15. ----------------------------------------------------------------*)
  16. Syntax10i.Scn.Fnt
  17. StampElems
  18. Alloc
  19. 8 May 95
  20. Syntax10b.Scn.Fnt
  21. Documentation
  22. MODULE Xref;  (*HM  9 Feb 89 / 
  23. IMPORT Viewers, MenuViewers, TextFrames, Texts, Oberon, Strings;
  24. CONST
  25.     hTabSize = 569;  (*hash table size: 4*i+3*)
  26.     kTabSize = 45;  (*at most 45 keywords*)
  27.     kln = 15;  (*max.length of a keyword*)
  28.     Alfa = ARRAY kln OF CHAR;
  29.     Ref = POINTER TO Item;
  30.     Item = RECORD
  31.         lno: INTEGER;
  32.         next: Ref
  33.     END;
  34.     Word = RECORD
  35.         key: Alfa;
  36.         first: Ref
  37.     END;
  38.     HashTab = ARRAY hTabSize OF Word;  (*hash table*)
  39.     w: Texts.Writer;
  40.     nk: INTEGER;  (*nr.of keywords*)
  41.     n: INTEGER;  (*current line number*)
  42.     nopl: INTEGER;  (*nr.of line numbers per page*)
  43.     llng: INTEGER;  (*line length*)
  44.     dgpn: INTEGER;  (*digits per number*)
  45.     key: ARRAY kTabSize OF Alfa;  (*keyword list*)
  46. PROCEDURE InitTab; (*initialize keyword table*)
  47.     PROCEDURE AddKey(s: ARRAY OF CHAR);
  48.     BEGIN
  49.         INC(nk); COPY(s, key[nk])
  50.     END AddKey;
  51. BEGIN
  52.     nk:=0;
  53.     AddKey("ARRAY");
  54.     AddKey("BEGIN");
  55.     AddKey("BOOLEAN");
  56.     AddKey("CASE");
  57.     AddKey("CHAR");
  58.     AddKey("CLOSE");
  59.     AddKey("CONST");
  60.     AddKey("DEFINITION");
  61.     AddKey("DIV");
  62.     AddKey("DO");
  63.     AddKey("ELSE");
  64.     AddKey("ELSIF");
  65.     AddKey("END");
  66.     AddKey("EXIT");
  67.     AddKey("FALSE");
  68.     AddKey("IF");
  69.     AddKey("IMPORT");
  70.     AddKey("IN");
  71.     AddKey("INTEGER");
  72.     AddKey("IS");
  73.     AddKey("LONGINT");
  74.     AddKey("LONGREAL");
  75.     AddKey("LOOP");
  76.     AddKey("MOD");
  77.     AddKey("MODULE");
  78.     AddKey("NIL");
  79.     AddKey("OF");
  80.     AddKey("OR");
  81.     AddKey("POINTER");
  82.     AddKey("PROCEDURE");
  83.     AddKey("REAL");
  84.     AddKey("RECORD");
  85.     AddKey("REPEAT");
  86.     AddKey("RETURN");
  87.     AddKey("SET");
  88.     AddKey("SHORTINT");
  89.     AddKey("THEN");
  90.     AddKey("TO");
  91.     AddKey("TRUE");
  92.     AddKey("TYPE");
  93.     AddKey("UNTIL");
  94.     AddKey("VAR");
  95.     AddKey("WHILE");
  96.     AddKey("WITH")
  97. END InitTab;
  98. PROCEDURE OpenViewer(VAR lst: Texts.Text);
  99.     VAR menu: Texts.Text; v: Viewers.Viewer; x, y: INTEGER;
  100. BEGIN
  101.     Oberon.AllocateUserViewer(0, x, y);
  102.     v := MenuViewers.New(
  103.         TextFrames.NewMenu("Xref.LST", "System.Close System.Copy System.Grow Edit.Store"),
  104.         TextFrames.NewText(TextFrames.Text(""), 0), TextFrames.menuH, x, y);
  105.     lst := v.dsc.next(TextFrames.Frame).text
  106. END OpenViewer;
  107. PROCEDURE WriteLnr;
  108. BEGIN
  109.     INC(n); Texts.WriteInt(w, n, 4); Texts.WriteString(w, "  ")
  110. END WriteLnr;
  111. PROCEDURE NoKey(id: ARRAY OF CHAR): BOOLEAN;
  112.     VAR i, j, k: INTEGER;
  113. BEGIN
  114.     i:=0; j:=nk - 1;
  115.     REPEAT
  116.         k:=(i+j) DIV 2;
  117.         IF id < key[k] THEN j:=k - 1 ELSE i:=k + 1 END
  118.     UNTIL i > j;
  119.     IF j < 0 THEN RETURN TRUE ELSE RETURN key[j] # id END
  120. END NoKey;
  121. PROCEDURE Search(id: ARRAY OF CHAR; VAR t: HashTab);
  122.     VAR h, d, len: INTEGER; x: Ref;
  123. BEGIN
  124.     len:=Strings.Length(id);
  125.     h:=(ORD(id[0]) + 17*ORD(id[len-1]) + len) * 7 MOD hTabSize;
  126.     d:= - hTabSize;
  127.     NEW(x); x.lno:=n;
  128.     LOOP
  129.         IF t[h].key[0] = 0X THEN  (*new entry*)
  130.             COPY(id, t[h].key); t[h].first:=x; x.next:=NIL; EXIT
  131.         ELSIF t[h].key = id THEN  (*found*)
  132.             x.next:=t[h].first; t[h].first:=x; EXIT
  133.         ELSE
  134.             INC(d, 2); IF d = hTabSize THEN HALT(20) END;
  135.             INC(h, ABS(d)); IF h >= hTabSize THEN DEC(h, hTabSize) END
  136.         END
  137. END Search;
  138. PROCEDURE Sort(VAR t: HashTab; l, r: INTEGER);
  139.     VAR i, j: INTEGER; x: Alfa; w: Word;
  140. BEGIN
  141.     i:=l; j:=r; x:=t[(i+j) DIV 2].key;
  142.     REPEAT
  143.         WHILE t[i].key < x DO INC(i) END;
  144.         WHILE x < t[j].key DO DEC(j) END;
  145.         IF i <= j THEN
  146.             w:=t[i]; t[i]:=t[j]; t[j]:=w;
  147.             INC(i); DEC(j)
  148.         END
  149.     UNTIL i > j;
  150.     IF l < j THEN Sort(t, l, j) END;
  151.     IF i < r THEN Sort(t, i, r) END
  152. END Sort;
  153. PROCEDURE PrintWord(word: Word);
  154.     VAR i, l, wl: INTEGER; x, y, z: Ref;
  155. BEGIN
  156.     wl:=Strings.Length(word.key);
  157.     Texts.WriteString(w, "  "); Texts.WriteString(w, word.key);
  158.     i:=wl; WHILE i < kln DO Texts.Write(w, " "); INC(i) END;  (*fill with blanks*)
  159.     x:=word.first; y:=x.next; x.next:=NIL;
  160.     WHILE y # NIL DO  (*invert order of line numbers*)
  161.         z:=y.next; y.next:=x; x:=y; y:=z
  162.     END;
  163.     l:=0; 
  164.     REPEAT
  165.         IF l = nopl THEN
  166.             Texts.WriteLn(w); l:=0; i:=0; WHILE i < kln + 2 DO Texts.Write(w, " "); INC(i) END
  167.         END;
  168.         INC(l); Texts.WriteInt(w, x.lno, dgpn); x:=x.next
  169.     UNTIL x = NIL;
  170.     Texts.WriteLn(w)
  171. END PrintWord;
  172. PROCEDURE PrintTable(VAR t: HashTab);
  173.     VAR i, m: INTEGER;
  174. BEGIN  (*compress table*)
  175.     m:=0; i:=0;
  176.     WHILE i < hTabSize DO
  177.         IF t[i].key[0] # 0X THEN t[m]:=t[i]; INC(m) END;
  178.         INC(i)
  179.     END;
  180.     IF m > 0 THEN Sort(t, 0, m-1) END;
  181.     nopl:=(llng-kln-2) DIV dgpn;
  182.     i:=0; WHILE i < m DO PrintWord(t[i]); INC(i) END
  183. END PrintTable;
  184. PROCEDURE Process (src: Texts.Text);    (* marked viewer *)
  185.     VAR r: Texts.Reader; lst: Texts.Text; t: HashTab; id: Alfa; ch, och: CHAR; level, k: INTEGER;
  186.     PROCEDURE NextCh;
  187.     BEGIN
  188.         Texts.Write(w, ch); Texts.Read(r, ch)
  189.     END NextCh;
  190. BEGIN
  191.     OpenViewer(lst);
  192.     n:=0; WriteLnr; 
  193.     k:=0; WHILE k < hTabSize DO t[k].key[0]:=0X; t[k].first:=NIL; INC(k) END;
  194.     Texts.OpenReader(r, src, 0); Texts.Read(r, ch);
  195.     WHILE ch # 0X DO
  196.         CASE ch OF
  197.             "A".."Z", "a".."z":
  198.                 k:=0;
  199.                 REPEAT
  200.                     IF k < kln THEN id[k]:=ch; INC(k) END;
  201.                     NextCh
  202.                 UNTIL ~ (((CAP(ch)>="A") & (CAP(ch)<="Z")) OR ((ch>="0") & (ch<="9")));
  203.                 IF k >= kln THEN k:=kln - 1 END; id[k]:=0X;
  204.                 IF NoKey(id) THEN Search(id, t) END
  205.         |  "0".."9":
  206.                 REPEAT NextCh UNTIL (ch >= "9") OR (ch <= "0")
  207.         | "'", 22X:
  208.                 och:=ch;
  209.                 LOOP
  210.                     NextCh; IF (ch = 0X) OR (ch = 0DX) THEN EXIT END;
  211.                     IF ch = och THEN NextCh; EXIT END
  212.                 END
  213.         | 0DX:
  214.                 NextCh; WriteLnr
  215.         |  "(":
  216.                 NextCh;
  217.                 IF ch = "*" THEN
  218.                     NextCh; level:=1;
  219.                     LOOP
  220.                         IF ch = 0X THEN EXIT
  221.                         ELSIF ch = 0DX THEN NextCh; WriteLnr
  222.                         ELSIF ch = "*" THEN
  223.                             NextCh;
  224.                             IF ch = ")" THEN 
  225.                                 NextCh; DEC(level); 
  226.                                 IF level = 0 THEN EXIT END
  227.                             END
  228.                         ELSIF ch = "(" THEN
  229.                             NextCh;
  230.                             IF ch = "*" THEN NextCh; INC(level) END
  231.                         ELSE NextCh
  232.                         END
  233.                     END  (*LOOP*)
  234.                 END
  235.         ELSE
  236.             NextCh
  237.         END  (*CASE*)
  238.     END;
  239.     Texts.WriteLn(w); Texts.WriteLn(w);
  240.     PrintTable(t);
  241.     Texts.Append(lst, w.buf)
  242. END Process;
  243. PROCEDURE List*;
  244.     VAR s: Texts.Scanner; src, t: Texts.Text; beg, end, time: LONGINT; v : Viewers.Viewer;
  245. BEGIN
  246.     Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  247.     IF (s.class = Texts.Char) & (s.c = "^") THEN
  248.         Oberon.GetSelection(t, beg, end, time);
  249.         IF time >= 0 THEN Texts.OpenScanner(s, t, beg); Texts.Scan(s) END
  250.     END;
  251.     IF (s.class = Texts.Char) & (s.c = "*") THEN
  252.         v := Oberon.MarkedViewer(); src := v.dsc.next(TextFrames.Frame).text;
  253.         Process(src)
  254.     ELSE
  255.         WHILE s.class = Texts.Name DO
  256.             NEW(src); Texts.Open(src, s.s);
  257.             Process(src);
  258.             Texts.Scan(s)
  259.         END
  260. END List;
  261. PROCEDURE IntPar(min, max: LONGINT): INTEGER;
  262.     VAR par: Oberon.ParList; s: Texts.Scanner; i: LONGINT;
  263. BEGIN
  264.     par:=Oberon.Par; Texts.OpenScanner(s, par.text, par.pos); Texts.Scan(s);
  265.     IF s.class = 3 THEN i:=s.i ELSE i:=0 END;
  266.     IF i < min THEN i:=min ELSIF i > max THEN i:=max END;
  267.     RETURN SHORT(i)
  268. END IntPar;
  269. PROCEDURE SetLineLength*;    (* number *)
  270. BEGIN
  271.     llng:=IntPar(kln + dgpn + 1, 120)
  272. END SetLineLength;
  273. PROCEDURE SetNumberLength*;    (* number *)
  274. BEGIN
  275.     dgpn:=IntPar(0, 5)
  276. END SetNumberLength;
  277. BEGIN
  278.     Texts.OpenWriter(w); llng:=100; dgpn:=5; InitTab
  279. END Xref.
  280.